perm filename COPYIT.F4[P11,LCS] blob sn#570611 filedate 1981-03-09 generic text, type T, neo UTF8
	SUBROUTINE STFCH
	CALL CPYIT(1)
	END
	SUBROUTINE COPYIT
	CALL CPYIT(0)
	END

	SUBROUTINE CPYIT(KC)
	INTEGER PWDS
	COMMON/XRN/RN(1) /POSI/S(8),JJ2,P
	COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS,VY,JQ(17)
	1/PTR/PWDS(1) /LIMIT/LIM,ITEM,LL,I,IX
 	EQUIVALENCE (R4,RJQ(2)),(R5,RJQ(3)),(R7,RJQ(5))
 	1,(R6,RJQ(4))

C KC IS FLAG FOR STFCH ROUTINE
	IM=ITEM
	DO 1 K=1,IM
	L=PWDS(K)
	IF(RTLINE(L))GO TO 1
	IF(OUTLMT(R4,R5,RN(L+3)))GO TO 1
	IF(R6.NE.0.AND.R6.NE.RN(L+1))GO TO 1
	IF(KC.NE.0)GO TO 2
	M=RN(L)+2
	CALL LOOP(0,M,1,I,L,RN)
	ITEM=ITEM+1
	L=PWDS(ITEM)
2	IF(R7.LE.7.)RN(L+2)=R7
	IF(KC.EQ.0)GO TO 3
	IF(K.LT.JJ2)JJ2=K
	GO TO 1 
3	IF(ITEM.LT.JJ2)JJ2=ITEM
	I=I+M+1
	PWDS(ITEM+1)=I
 1	CONTINUE
	IF(KC.EQ.0)R2=R7
	END